Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/C/Utilities/byacc 1.8.2/test/calc.y

Text File | 1993-02-04 | 5.0 KB | 257 lines | [TEXT/R*ch]

/*
    Simple calculator implemented in Perl.
    The grammar is standard YACC, but the actions are in Perl.
    This YACC file must be processed by a version of YACC that
    supports Perl output.

    The calculator handles the basic operations, but nothing fancy.
    This is mostly a demonstration of the Perl/Yacc combination.

    $P holds the previous value, that is, the value of the most
       recent expression.  The user can refer to this with "%".
    %V holds user-defined variables; variables are defined by assinging
       to them.  References to an undefined variable produces a warning,
       and assigns 0 to the variable.
    The user can also get a Perl escape with &, followed by a string.

    Ray Lischner
    17 August 1990
*/

%token INT FLOAT STRING IDENT

%left    '='
%left    '|'
%left    '&'
%left    EQ NE
%left    GT GE LT LE
%left    L_SHIFT R_SHIFT
%left    '+' '-'
%left    '*' '/'
%right    EXP
%right    '!'
%right    UNARY

%start    stmt_list

%%

stmt_list:    /* empty */
    |    stmt_list stmt
    ;

stmt:        terminator
    |    expr terminator
        { print $1, "\n" if $2 eq "\n"; $P = $1; }
    |    error terminator
        { &yyerrok; }
    ;

terminator:    ';'
        { $$ = $1; }
    |    '\n'
        { $$ = $1; }
    ;

expr:        '(' expr ')'
        { $$ = $2; }
    |    expr '|' expr
        { $$ = $1 || $3; }
    |    expr '&' expr
        { $$ = $1 && $3; }
    |    expr EQ expr
        { $$ = $1 == $3; }
    |    expr NE expr
        { $$ = $1 != $3; }
    |    expr GT expr
        { $$ = $1 > $3; }
    |    expr GE expr
        { $$ = $1 >= $3; }
    |    expr LT expr
        { $$ = $1 < $3; }
    |    expr LE expr
        { $$ = $1 <= $3; }
    |    expr L_SHIFT expr
        { $$ = $1 << $3; }
    |    expr R_SHIFT expr
        { $$ = $1 >> $3; }
    |    expr '+' expr
        { $$ = $1 + $3; }
    |    expr '-' expr
        { $$ = $1 - $3; }
    |    expr '*' expr
        { $$ = $1 * $3; }
    |    expr '/' expr
        { $$ = $1 / $3; }
    |    expr EXP expr
        { $$ = $1 ** $3; }
    |    expr '!'
        { $$ = &fact($1); }
    |    '-' expr        %prec UNARY
        { $$ = -$2; }
    |    '!' expr        %prec UNARY
        { $$ = !$2; }
    |    '+' expr        %prec UNARY
        { $$ = $2; }
    |    '&' STRING        %prec UNARY
        { $$ = eval($2); }
    |    IDENT '=' expr
        { eval '$V{'.$1.'}=('.$3.'); 1' || &yyerror($@); $$ = $V{$1}; }
    |    IDENT
        { if (! defined $V{$1}) {
            &yyerror($1.": undefined variable");
            $V{$1} = 0;
          }
          $$ = $V{$1};
        }
    |    INT
        { $$ = $1; }
    |    FLOAT
        { $$ = $1; }
    |    STRING
        { $$ = $1; }
    |    '%'
        { $$ = $P; }
    ;

%%

# Prompt the user on STDERR, but only prompt if STDERR and the input
# file are both terminals.

# read from STDIN if no files are named on the command line
unshift(@ARGV, '-') if $#ARGV < $[;

# After finishing a file, open the next one.  Return whether there
# really is a next one that was opened.
sub next_file
{
    while ($ARGV = shift(@ARGV)) {
    if (! open(ARGV, $ARGV)) {
        print STDERR "$ARGV: cannot open file: $!\n";
        next;
    }
    $prompt = (-t ARGV && -t STDERR) ? '(Calc) ' : '';
    last;
    }
    $ARGV >= $[;
}

# print he prompt
sub prompt
{
    print STDERR $prompt if $prompt;
}

# print an error message
sub yyerror
{
    print STDERR "\"$ARGV\", " if $ARGV ne '-';
    print STDERR "line $.: ", @_, "\n";
}

# Hand-coded lex until I write lex -p, too!
sub yylex
{
 lexloop:
    {
    # get a line of input, if we need it.
    if ($line eq '') {
        &prompt;
        $line = <ARGV>;
        if ($line eq '') {
        close(ARGV);
        &next_file || return(0);
        }
    }

    # Skip over white space, and grab the first character.
    # If there is no such character, then grab the next line.
    $line =~ s/^[ \t\f\r\v]*(.|\n)//    || next lexloop;
    local($char) = $1;
    if ($char eq '#') {
        # comment, so discard the line
        $line = "\n";
        &yylex;
    } elsif ($char =~ /^['"]/) {
        # collect the string
        if ($line =~ s/^([^$char]*)$char//) {
        $yylval = $1;
        } else {
        &yyerror('unterminated string');
        $yylval = '';
        }
        $STRING;
    } elsif ($char =~ /^\d/) {
        # number, is it integer or float?
        if ($line =~ s/^(\d+)//) {
        $yylval = int($char . $1);
        } else {
        $yylval = int($char);
        }
        $type = $INT;
        if ($line =~ s/^(\.\d*)//) {
        $tmp = "0$1";
        $yylval += $tmp;
        $type = $FLOAT;
        }
        if ($line =~ s/^[eE]([-+]*\d+)//) {
        $yylval *= 10 ** $1;
        $type = $FLOAT;
        }
        $type;
    } elsif ($char =~ /^\w/) {
        # identifier
        $line =~ s/^([\w\d]*)//;
        $yylval = $char.$1;
        $IDENT;
    } elsif ($char eq '*' && $line =~ s/^\*//) {
        $EXP;
    } elsif ($char eq '!' && $line =~ s/^=//) {
        $NE;
    } elsif ($char eq '=' && $line =~ s/^=//) {
        $EQ;
    } elsif ($char =~ /^[<>]/ && $line =~ s/^=//) {
        $char eq '<' ? $LE : $GE;
    } elsif ($char =~ /^[<>]/ && $line =~ s/^$char//) {
        $char eq '<' ? $L_SHIFT : $R_SHIFT;
    } else {
        $yylval = $char;
        ord($char);
    }
    }
}

# factorial
sub fact
{
    local($n) = @_;
    local($f) = 1;
    $f *= $n-- while ($n > 1) ;
    $f;
}

# catch signals
sub catch
{
    local($signum) = @_;
    print STDERR "\n" if (-t STDERR && -t STDIN);
    &yyerror("Floating point exception") if $signum = 8;
    next outer;
}
$SIG{'INT'} = 'catch';
$SIG{'FPE'} = 'catch';

select(STDERR); $| = 1;
select(STDOUT);
&next_file;

# main program
outer: while(1)
{
    $line = '';
    eval '$status = &yyparse;';
    exit $status if ! $@;
    &yyerror($@);
}